home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / xlisp-1.6 / trace.lsp < prev   
Encoding:
Lisp/Scheme  |  1991-10-06  |  1.9 KB  |  47 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         trace.lsp
  5. ; RCS:          $Header: $
  6. ; Description:  trace functions for xlisp 1.6
  7. ; Author:       ???
  8. ; Created:      Sat Oct  5 21:03:47 1991
  9. ; Modified:     Sat Oct  5 21:04:14 1991 (Niels Mayer) mayer@hplnpm
  10. ; Language:     Lisp
  11. ; Package:      N/A
  12. ; Status:       X11r5 contrib tape release
  13. ;
  14. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. ;
  17. ; Permission to use, copy, modify, distribute, and sell this software and its
  18. ; documentation for any purpose is hereby granted without fee, provided that
  19. ; the above copyright notice appear in all copies and that both that
  20. ; copyright notice and this permission notice appear in supporting
  21. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  22. ; used in advertising or publicity pertaining to distribution of the software
  23. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  24. ; makes no representations about the suitability of this software for any
  25. ; purpose.  It is provided "as is" without express or implied warranty.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. (setq *tracelist* nil)
  29.  
  30. (defun evalhookfcn (expr &aux val)
  31.        (if (and (consp expr) (member (car expr) *tracelist*))
  32.            (progn (princ ">>> ") (print expr)
  33.                   (setq val (evalhook expr evalhookfcn nil))
  34.                   (princ "<<< ") (print val))
  35.            (evalhook expr evalhookfcn nil)))
  36.  
  37. (defun trace (fun)
  38.        (if (not (member fun *tracelist*))
  39.        (progn (setq *tracelist* (cons fun *tracelist*))
  40.                   (setq *evalhook* evalhookfcn)))
  41.        *tracelist*)
  42.  
  43. (defun untrace (fun)
  44.        (if (null (setq *tracelist* (delete fun *tracelist*)))
  45.            (setq *evalhook* nil))
  46.        *tracelist*)
  47.